Class CompareEx
    Private caseSensitive
    Private compareMode
    Private ignoreWhitespace
    Private dateTolerance
    Private numericTolerance
    
    ' 比较模式枚举
    Private COMPARE_BINARY     ' 二进制比较
    Private COMPARE_TEXT       ' 文本比较
    Private COMPARE_DATABASE   ' 数据库比较(不区分大小写和空格)
    
    ' 类初始化
    Private Sub Class_Initialize()
        ' 初始化比较模式枚举
        COMPARE_BINARY = 0
        COMPARE_TEXT = 1
        COMPARE_DATABASE = 2
        
        ' 默认设置
        caseSensitive = False
        compareMode = COMPARE_TEXT
        ignoreWhitespace = False
        dateTolerance = 0 ' 日期比较容忍度(天)
        numericTolerance = 0.000001 ' 数字比较容忍度
    End Sub
    
    ' ================ 配置方法 ================
    
    ' 设置是否区分大小写
    Public Property Let SetCaseSensitive(value)
        caseSensitive = value
    End Property
    
    Public Property Get GetCaseSensitive()
        CaseSensitive = caseSensitive
    End Property
    
    ' 设置比较模式
    Public Property Let SetCompareMode(mode)
        compareMode = mode
        ' 根据模式自动设置其他属性
        Select Case mode
            Case COMPARE_BINARY
                caseSensitive = True
                ignoreWhitespace = False
            Case COMPARE_TEXT
                caseSensitive = False
                ignoreWhitespace = False
            Case COMPARE_DATABASE
                caseSensitive = False
                ignoreWhitespace = True
        End Select
    End Property
    
    Public Property Get GetCompareMode()
        CompareMode = compareMode
    End Property
    
    ' 设置是否忽略空白
    Public Property Let SetIgnoreWhitespace(value)
        ignoreWhitespace = value
    End Property
    
    Public Property Get GetIgnoreWhitespace()
        IgnoreWhitespace = ignoreWhitespace
    End Property
    
    ' 设置日期比较容忍度(天)
    Public Property Let SetDateTolerance(days)
        dateTolerance = days
    End Property
    
    Public Property Get GetDateTolerance()
        DateTolerance = dateTolerance
    End Property
    
    ' 设置数字比较容忍度
    Public Property Let SetNumericTolerance(tolerance)
        numericTolerance = tolerance
    End Property
    
    Public Property Get GetNumericTolerance()
        NumericTolerance = numericTolerance
    End Property
    
    ' ================ 比较方法 ================
    
    ' 等于比较
    Public Function Equal(value1, value2)
        Equal = (Compare(value1, value2) = 0)
    End Function
    
    ' 不等于比较
    Public Function NotEqual(value1, value2)
        NotEqual = (Compare(value1, value2) <> 0)
    End Function
    
    ' 大于比较
    Public Function GreaterThan(value1, value2)
        GreaterThan = (Compare(value1, value2) > 0)
    End Function
    
    ' 大于或等于比较
    Public Function GreaterThanOrEqual(value1, value2)
        GreaterThanOrEqual = (Compare(value1, value2) >= 0)
    End Function
    
    ' 小于比较
    Public Function LessThan(value1, value2)
        LessThan = (Compare(value1, value2) < 0)
    End Function
    
    ' 小于或等于比较
    Public Function LessThanOrEqual(value1, value2)
        LessThanOrEqual = (Compare(value1, value2) <= 0)
    End Function
    
    ' 核心比较方法
    Public Function Compare(value1, value2)
        ' 处理Null和Empty
        If IsNull(value1) Or IsNull(value2) Then
            Compare = CompareNulls(value1, value2)
            Exit Function
        End If
        
        If IsEmpty(value1) Or IsEmpty(value2) Then
            Compare = CompareEmpties(value1, value2)
            Exit Function
        End If
        
        ' 处理不同类型
        If VarType(value1) <> VarType(value2) Then
            ' 尝试数字比较
            If IsNumeric(value1) And IsNumeric(value2) Then
                Compare = CompareNumbers(CDbl(value1), CDbl(value2))
                Exit Function
            End If
            
            ' 尝试日期比较
            If IsDate(value1) And IsDate(value2) Then
                Compare = CompareDates(CDate(value1), CDate(value2))
                Exit Function
            End If
            
            ' 类型不同
            Compare = CompareTypes(VarType(value1), VarType(value2))
            Exit Function
        End If
        
        ' 相同类型比较
        Select Case VarType(value1)
            Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbDecimal
                Compare = CompareNumbers(CDbl(value1), CDbl(value2))
            Case vbDate
                Compare = CompareDates(CDate(value1), CDate(value2))
            Case vbString
                Compare = CompareStrings(CStr(value1), CStr(value2))
            Case vbBoolean
                Compare = CompareBooleans(CBool(value1), CBool(value2))
            Case vbObject
                Compare = CompareObjects(value1, value2)
            Case vbArray + vbVariant
                Compare = CompareArrays(value1, value2)
            Case Else
                ' 其他类型使用默认比较
                If value1 = value2 Then
                    Compare = 0
                ElseIf value1 < value2 Then
                    Compare = -1
                Else
                    Compare = 1
                End If
        End Select
    End Function
    
    ' ================ 集合比较方法 ================
    
    ' 数组是否包含值
    Public Function ArrayContains(arr, value)
        Dim i
        For i = LBound(arr) To UBound(arr)
            If Equal(arr(i), value) Then
                ArrayContains = True
                Exit Function
            End If
        Next
        ArrayContains = False
    End Function
    
    ' 字典是否包含键
    Public Function DictionaryHasKey(dict, key)
        On Error Resume Next
        DictionaryHasKey = dict.Exists(NormalizeKey(key))
        On Error GoTo 0
    End Function
    
    ' 字典是否包含值
    Public Function DictionaryHasValue(dict, value)
        Dim key
        For Each key In dict.Keys
            If Equal(dict(key), value) Then
                DictionaryHasValue = True
                Exit Function
            End If
        Next
        DictionaryHasValue = False
    End Function
    
    ' 比较两个字典是否相等
    Public Function DictionariesEqual(dict1, dict2)
        If dict1.Count <> dict2.Count Then
            DictionariesEqual = False
            Exit Function
        End If
        
        Dim key
        For Each key In dict1.Keys
            If Not DictionaryHasKey(dict2, key) Then
                DictionariesEqual = False
                Exit Function
            End If
            If Not Equal(dict1(key), dict2(key)) Then
                DictionariesEqual = False
                Exit Function
            End If
        Next
        
        DictionariesEqual = True
    End Function
    
    ' ================ 私有比较方法 ================
    
    ' 比较Null值
    Private Function CompareNulls(value1, value2)
        If IsNull(value1) And IsNull(value2) Then
            CompareNulls = 0
        ElseIf IsNull(value1) Then
            CompareNulls = -1
        Else
            CompareNulls = 1
        End If
    End Function
    
    ' 比较Empty值
    Private Function CompareEmpties(value1, value2)
        If IsEmpty(value1) And IsEmpty(value2) Then
            CompareEmpties = 0
        ElseIf IsEmpty(value1) Then
            CompareEmpties = -1
        Else
            CompareEmpties = 1
        End If
    End Function
    
    ' 比较类型
    Private Function CompareTypes(type1, type2)
        If type1 = type2 Then
            CompareTypes = 0
        ElseIf type1 < type2 Then
            CompareTypes = -1
        Else
            CompareTypes = 1
        End If
    End Function
    
    ' 比较数字(考虑容忍度)
    Private Function CompareNumbers(num1, num2)
        If Abs(num1 - num2) <= numericTolerance Then
            CompareNumbers = 0
        ElseIf num1 < num2 Then
            CompareNumbers = -1
        Else
            CompareNumbers = 1
        End If
    End Function
    
    ' 比较日期(考虑容忍度)
    Private Function CompareDates(date1, date2)
        Dim diff
        diff = DateDiff("s", date1, date2) / 86400 ' 转换为天数
        
        If Abs(diff) <= dateTolerance Then
            CompareDates = 0
        ElseIf diff > 0 Then ' date1 < date2
            CompareDates = -1
        Else
            CompareDates = 1
        End If
    End Function
    
    ' 比较字符串
    Private Function CompareStrings(str1, str2)
        ' 预处理字符串
        If Not caseSensitive Then
            str1 = LCase(str1)
            str2 = LCase(str2)
        End If
        
        If ignoreWhitespace Then
            str1 = Trim(str1)
            str2 = Trim(str2)
        End If
        
        ' 比较
        If str1 = str2 Then
            CompareStrings = 0
        ElseIf str1 < str2 Then
            CompareStrings = -1
        Else
            CompareStrings = 1
        End If
    End Function
    
    ' 比较布尔值
    Private Function CompareBooleans(bool1, bool2)
        If bool1 = bool2 Then
            CompareBooleans = 0
        ElseIf bool1 < bool2 Then ' False < True
            CompareBooleans = -1
        Else
            CompareBooleans = 1
        End If
    End Function
    
    ' 比较对象
    Private Function CompareObjects(obj1, obj2)
        If obj1 Is obj2 Then
            CompareObjects = 0
            Exit Function
        End If
        
        ' 尝试比较默认属性
        On Error Resume Next
        Dim val1, val2
        val1 = obj1.Value
        val2 = obj2.Value
        If Err.Number = 0 Then
            CompareObjects = Compare(val1, val2)
            Exit Function
        End If
        On Error GoTo 0
        
        ' 无法比较
        CompareObjects = -1
    End Function
    
    ' 比较数组
    Private Function CompareArrays(arr1, arr2)
        ' 比较数组长度
        If UBound(arr1) - LBound(arr1) <> UBound(arr2) - LBound(arr2) Then
            CompareArrays = CompareNumbers(UBound(arr1) - LBound(arr1), UBound(arr2) - LBound(arr2))
            Exit Function
        End If
        
        ' 比较每个元素
        Dim i
        For i = LBound(arr1) To UBound(arr1)
            Dim cmpResult
            cmpResult = Compare(arr1(i), arr2(i))
            If cmpResult <> 0 Then
                CompareArrays = cmpResult
                Exit Function
            End If
        Next
        
        CompareArrays = 0
    End Function
    
    ' 规范化字典键(根据比较设置)
    Private Function NormalizeKey(key)
        If VarType(key) = vbString And Not caseSensitive Then
            NormalizeKey = LCase(key)
        Else
            NormalizeKey = key
        End If
    End Function
End Class